home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / system / stack.zip / MANUAL.PAS < prev    next >
Pascal/Delphi Source File  |  1987-12-10  |  16KB  |  562 lines
  1. PROGRAM MANUAL;
  2.  
  3. const
  4.  
  5. { See documentation for notes on how to modify these constants }
  6.  
  7.   bold     = #02;         {wordstar bold face}
  8.   double   = #04;
  9.   pagelines = 66;         {default lines per printed page}
  10.   tab_posn = 10;
  11.   striptop = 127;        {used to strip top bit off bytes}
  12. {colours for monitor control}
  13.   lightgrey = 7;
  14.   black     = 0;
  15.   lightblue = 9;
  16.   yellow    = 14;
  17.  
  18.  
  19.   title    = '         Documentation Display System - Version 1.4, Dec 87';
  20.   author   = '                                        by Shane Bergl';
  21.   scrnsize = 21;
  22.   PageWidth = 95;
  23.   FormFeed = #12;
  24.   ctrla    = #01;         {control a char}
  25.   onefox   = #31;         { 1F hex}
  26.   cr       = #13;         {carriage return}
  27.   lf       = #10;         {line feed}
  28.   pgup     = #73;         {PgUp key less ESC code}
  29.   pgdn     = #81;         {PgDn key less ESC code}
  30.   lnup     = #72;         {up arrow less ESC code}
  31.   lndn     = #80;         {down arrow less ESC code}
  32.   nd       = #79;         {End key less ESC code}
  33.   home     = #71;         {home key less ESC code}
  34.   esc      = #27;
  35.   blank    = #32;
  36.   maxline  = 20;          {max lines per screen}
  37.   firstline = 2;          {first line for text}
  38.   text_size = 512;
  39.   space80  =
  40. '                                                                                 ';
  41.   screen   = true;
  42.   printer  = false;
  43.  
  44. type
  45.   filename   =  string[12];
  46.   line       =  record
  47.                   detail   :  string[75];
  48.                   sect     :  integer;
  49.                 end;
  50.   scr        =  array[1..20] of line;
  51.   scrn_ptr   =  ^scrn_type;
  52.   scrn_type  =  record
  53.                   scrn     :  scr;
  54.                   next_scr :  scrn_ptr;
  55.                 end;
  56.   workstr    =  string[79];
  57.   buff       =  array[1..512] of byte;
  58.  
  59. var
  60.   infile     :  file of buff;
  61.   doco       :  file of workstr;
  62.   index      :  file of scr;
  63.   testfile   :  text;
  64.   doco_file_name : filename;
  65.   heading,
  66.   boldface,
  67.   finished   :  boolean;
  68.   size_of_file,
  69.   curline,
  70.   printlength :  integer;
  71.   curscr,
  72.   contents   :  scrn_ptr;
  73.   key        :  char;
  74.  
  75. {----------------------------------------------------------}
  76.  
  77. procedure highon;
  78.  
  79. begin
  80.   textbackground(lightgrey);
  81.   textcolor(black);
  82. end;
  83.  
  84. {----------------------------------------------------------}
  85.  
  86. procedure highoff;
  87.  
  88. begin
  89.   textbackground(lightblue);
  90.   textcolor(yellow);
  91. end;
  92.  
  93. {----------------------------------------------------------}
  94.  
  95. procedure init;
  96.  
  97. var result : integer;
  98.  
  99. Function exists(name: filename): boolean;
  100.   var  fp : file;
  101.   begin
  102.     Assign(fp,Name);
  103.     {$I-} reset(fp); {$I+}
  104.     If IOresult <> 0 then
  105.       exists := False
  106.     else
  107.       exists := True;
  108.     {end if}
  109.     close(fp);
  110.   end { exists };
  111.  
  112.  
  113. Procedure checkfiles;
  114.   begin
  115.     If ParamCount = 0 then begin
  116.       Write('Enter documentation name: ');
  117.       readln(doco_file_name);
  118.       end
  119.     else begin
  120.       doco_file_name := ParamStr(1);
  121.     end;
  122.     If Not exists(doco_file_name + '.DOC') then
  123.       if not exists(doco_file_name + '.IDX')
  124.       and not exists(doco_file_name + '.DOK') then begin
  125.         Writeln('ERROR -- documentation not found:  ',doco_file_name);
  126.         Halt;
  127.       end; {if}
  128.   end {checkfiles};
  129.  
  130. begin {init}
  131.   clrscr;
  132.   checkfiles;
  133.   if ParamCount < 2 then
  134.     Printlength := pagelines
  135.   else
  136.     val(ParamStr(2),PrintLength,result);
  137.   {end if}
  138.   PrintLength := PrintLength - 6;  {3 lines each for header and footer}
  139.   highoff;
  140.   gotoxy(1, 10);
  141.   writeln(' ':29, 'Please wait', ' ':39);
  142. {a quick bit of publicity}
  143.   writeln;
  144.   writeln(title, ' ':78-length(title));
  145.   writeln(author, ' ':78-length(author));
  146.   writeln;
  147. {end of ad}
  148.   contents := nil;
  149.   curline := 1;
  150.   finished := false;
  151.   curscr := nil;
  152. end;
  153.  
  154. {----------------------------------------------------------}
  155.  
  156. Function CmdLine(inbuf : workstr) : boolean;
  157.  
  158. begin
  159.   if (inbuf[1] = '.') and ((inbuf[2]='P')or(inbuf[2]='p'))
  160.   and ((inbuf[3]='A')or(inbuf[3]='a')) then
  161.     CmdLine := true
  162.   else
  163.     CmdLine := false;
  164.   {end if}
  165. end;
  166.  
  167. {----------------------------------------------------------}
  168.  
  169. procedure print(lines2print:integer; screen:boolean; var stopped:boolean;
  170.                  var linecount:integer);
  171.  
  172. var  cur_row  : integer;
  173.      prtstr,
  174.      printstr,
  175.      dupe_str : workstr;
  176.      dupe     : boolean;
  177.      i        : integer;
  178.  
  179. begin
  180.   cur_row := 0;
  181.   if not screen then begin
  182.     gotoxy(1,scrnsize+firstline+1);
  183.     highon;
  184.     write('Printing, press any key to abort                                 ');
  185.     highoff;
  186.   end {if};
  187.   repeat
  188.     read(doco, printstr);
  189.     if CmdLine(printstr) then
  190.       if not screen then
  191.         cur_row := printlength
  192.       else
  193.         cur_row := cur_row
  194.       {end if} {Note: dummy statement required so IF..THEN..ELSEs work properly}
  195.     else begin
  196.       cur_row := succ(cur_row);
  197.       dupe_str := '';
  198.       prtstr := '';
  199.       dupe := false;
  200.       for i := 1 to length(PrintStr) do begin
  201.         if (printstr[i] >= blank) or (printstr[i] = bold)
  202.         or (printstr[i] = double) then
  203.           if (printstr[i] = bold) or (printstr[i] = double) then
  204.             dupe := not(dupe)
  205.           else
  206.             if dupe then
  207.               dupe_str := dupe_str + PrintStr[i]
  208.             else
  209.               dupe_str := dupe_str + ' ';
  210.             {end if}
  211.           {end if}
  212.         {end if}
  213.         if printstr[i] >= blank then prtstr := prtstr + printstr[i];
  214.       end {for};
  215.       if (dupe_str <> '') and not screen then write(lst,'          ', dupe_str, cr);
  216.       if screen then writeln(prtstr) else writeln(lst,'          ', prtstr);
  217.     end {if};
  218.   until (cur_row >= lines2print) or (cur_row >= printlength) or keypressed or eof(doco);
  219.   if keypressed then stopped := true else stopped := false;
  220.   linecount := cur_row;
  221. end {print};
  222.  
  223. {----------------------------------------------------------}
  224.  
  225. procedure lpr;
  226.  
  227. var
  228.   stopped   :  boolean;
  229.   i,
  230.   pagenum   :  integer;
  231.  
  232. begin
  233.   pagenum := 1;
  234.   reset(doco);
  235.   repeat
  236.     writeln(lst);
  237.     writeln(lst, ' ':(pagewidth div 2)-4, pagenum:3);
  238.     writeln(lst);
  239.     print(printlength, printer, stopped, i);
  240.     write(lst, formfeed);
  241.     pagenum := succ(pagenum);
  242.   until eof(doco) or stopped;
  243. end;
  244.  
  245.  
  246. procedure build_contents;
  247.  
  248.  
  249. procedure create_index;
  250. {---------------------}
  251.   var
  252.     i, k, curln, j, chrposn,
  253.     sect     : integer;
  254.     buf      : buff;
  255.     bite     : byte;
  256.     outstr   : workstr;
  257.     ch       : char;
  258.     line_of_blanks : boolean;
  259.  
  260.  
  261. procedure newrec;
  262.  
  263. begin
  264.   curln := 1;
  265.   if curscr = nil then begin
  266.     new(contents);
  267.     curscr := contents;
  268.     end
  269.   else begin
  270.     new(curscr^.next_scr);
  271.     curscr := curscr^.next_scr;
  272.   end; {if}
  273.   curscr^.next_scr := nil;
  274.   for k := 1 to maxline do begin
  275.     curscr^.scrn[k].detail := '     ';
  276.     curscr^.scrn[k].sect := 0;
  277.   end; {for}
  278. end;
  279.  
  280.  
  281.   begin
  282.     writeln(' ':28, 'Building Index', ' ':37);
  283.     curscr := nil;
  284.     heading := false;
  285.     line_of_blanks := true;
  286.     sect := 0;
  287.     outstr := '';
  288.     chrposn := 1;
  289.  
  290.   {build index}
  291.     curln := maxline;
  292.     while not eof(infile) do begin
  293.       read(infile, buf);
  294.       for i := 1 to 512 do begin
  295.         ch := chr(buf[i] and striptop);
  296.         case ch of
  297.           bold : if heading then begin
  298.                    heading := false;
  299.                    end
  300.                  else begin
  301.                    heading := true;
  302.                    curln := curln + 1;
  303.                    if curln > maxline then newrec;
  304.                    curscr^.scrn[curln].sect := sect;
  305.                    if chrposn = 1 then
  306.                      curscr^.scrn[curln].detail := curscr^.scrn[curln].detail
  307.                      + '    '
  308.                    else
  309.                      if not line_of_blanks then
  310.                        curscr^.scrn[curln].detail := curscr^.scrn[curln].detail
  311.                        + '        '
  312.                      else
  313.                        if chrposn <= tab_posn then
  314.                          curscr^.scrn[curln].detail
  315.